home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / viper / viper-mous.el < prev    next >
Encoding:
Text File  |  1995-08-11  |  17.7 KB  |  478 lines
  1. ;;; viper-mous.el -- Mouse support for Viper
  2. ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. (require 'viper-util)
  22.  
  23.  
  24. ;;; Variables
  25.   
  26. ;; Variable used for catching the switch-frame event.
  27. ;; If non-nil, indicates that previous-frame should be the selected
  28. ;; one. Used by vip-mouse-click-get-word. Not a user option.
  29. (defvar vip-frame-of-focus nil)
  30.     
  31. ;; Frame that was selected before the switch-frame event.
  32. (defconst vip-current-frame-saved (selected-frame))
  33.   
  34. (defvar vip-surrounding-word-function 'vip-surrounding-word
  35.   "*Function that determines what constitutes a word for clicking events.
  36. Takes two parameters: a COUNT, indicating how many words to return, 
  37. and CLICK-COUNT, telling whether this is the first click, a double-click,
  38. or a tripple-click.")
  39.        
  40. ;; time interval in millisecond within which successive clicks are
  41. ;; considered related
  42. (defconst vip-multiclick-timeout (if vip-xemacs-p
  43.                      mouse-track-multi-click-time
  44.                    double-click-time)
  45.   "*Time interval in millisecond within which successive clicks are
  46. considered related.")
  47.  
  48. ;; current event click count; XEmacs only
  49. (defvar vip-current-click-count 0)
  50. ;; time stamp of the last click event; XEmacs only
  51. (defvar vip-last-click-event-timestamp 0)
  52.  
  53. ;; Local variable used to toggle wraparound search on click.
  54. (vip-deflocalvar  vip-mouse-click-search-noerror t)
  55.     
  56. ;; Local variable used to delimit search after wraparound.
  57. (vip-deflocalvar  vip-mouse-click-search-limit nil)
  58.     
  59. ;; remembers prefix argument to pass along to commands invoked by second
  60. ;; click.
  61. ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
  62. ;; causes Emacs to count the second click as if it was a single click
  63. (defvar vip-global-prefix-argument nil)
  64.  
  65.  
  66.  
  67. ;;; Code
  68.  
  69. (defsubst vip-multiclick-p ()
  70.   (not (vip-sit-for-short vip-multiclick-timeout t)))
  71.          
  72. (defun vip-surrounding-word (count click-count)
  73.    "Returns word surrounding point according to a heuristic.
  74. COUNT indicates how many regions to return.
  75. If CLICK-COUNT is 1, `word' is a word in Vi sense.
  76. If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
  77. If the character clicked on is a non-separator and is non-alphanumeric but
  78. is adjacent to an alphanumeric symbol, then it is considered alphanumeric
  79. for the purpose of this command. If this character has a matching
  80. character, such as `\(' is a match for `\)', then the matching character is
  81. also considered alphanumeric.
  82. For convenience, in Lisp modes, `-' is considered alphanumeric.
  83.  
  84. If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
  85. trailing space and tabs removed. In that case, the first argument, COUNT,
  86. is ignored."
  87.    (let ((basic-alpha "_a-zA-Z0-9") ; it is important for `_' to come first
  88.      (basic-alpha-B "[_a-zA-Z0-9]")
  89.      (basic-nonalphasep-B vip-NONALPHASEP-B)
  90.      (end-modifiers "")
  91.      (start-modifiers "")
  92.      vip-ALPHA vip-ALPHA-B
  93.      vip-NONALPHA vip-NONALPHA-B
  94.      vip-ALPHASEP vip-ALPHASEP-B
  95.      vip-NONALPHASEP vip-NONALPHASEP-B
  96.      beg skip-flag result
  97.      one-char-word-func word-function-forw word-function-back word-beg)
  98.      (if (> click-count 2)
  99.      (save-excursion
  100.        (beginning-of-line)
  101.        (skip-chars-forward " \t")
  102.        (setq beg (point))
  103.        (end-of-line)
  104.        (setq result (buffer-substring beg (point))))
  105.        
  106.        (if (and (looking-at basic-nonalphasep-B)
  107.         (or (save-excursion (vip-backward-char-carefully)
  108.                     (looking-at basic-alpha-B))
  109.             (save-excursion (vip-forward-char-carefully)
  110.                     (looking-at basic-alpha-B))))
  111.        (setq start-modifiers
  112.          (cond ((looking-at "\\\\") "\\\\")
  113.                ((looking-at "-") "")
  114.                ((looking-at "[][]") "][")
  115.                ((looking-at "[()]") ")(")
  116.                ((looking-at "[{}]") "{}")
  117.                ((looking-at "[<>]") "<>")
  118.                ((looking-at "[`']") "`'")
  119.                ((looking-at "\\^") "")
  120.                ((looking-at vip-SEP-B) "")
  121.                (t (char-to-string (following-char))))
  122.          end-modifiers
  123.          (cond ((looking-at "-") "C-C-") ;; note the C-C trick
  124.                ((looking-at "\\^") "^")
  125.                (t ""))))
  126.        
  127.        ;; Add `-' to alphanum, if it wasn't added and in we are in Lisp
  128.        (or (looking-at "-")
  129.        (not (string-match "lisp" (symbol-name major-mode)))
  130.        (setq end-modifiers (concat end-modifiers "C-C-")))
  131.        
  132.        (setq vip-ALPHA
  133.          (format "%s%s%s" start-modifiers basic-alpha end-modifiers)
  134.          vip-ALPHA-B
  135.          (format "[%s%s%s]" start-modifiers basic-alpha end-modifiers)
  136.          vip-NONALPHA (concat "^" vip-ALPHA)
  137.          vip-NONALPHA-B (concat "[" vip-NONALPHA "]")
  138.          vip-ALPHASEP (concat vip-ALPHA vip-SEP)
  139.          vip-ALPHASEP-B
  140.          (format "[%s%s%s%s]"
  141.              start-modifiers basic-alpha vip-SEP end-modifiers)
  142.          vip-NONALPHASEP (format "^%s%s" vip-SEP vip-ALPHA)
  143.          vip-NONALPHASEP-B (format "[^%s%s]" vip-SEP vip-ALPHA)
  144.          )
  145.        
  146.        (if (> click-count 1)
  147.        (setq one-char-word-func 'vip-one-char-Word-p
  148.          word-function-forw 'vip-end-of-Word
  149.          word-function-back 'vip-backward-Word)
  150.      (setq one-char-word-func 'vip-one-char-word-p
  151.            word-function-forw 'vip-end-of-word
  152.            word-function-back 'vip-backward-word))
  153.        
  154.        (save-excursion
  155.      (cond ((> click-count 1) (skip-chars-backward vip-NONSEP))
  156.            ((looking-at vip-ALPHA-B) (skip-chars-backward vip-ALPHA))
  157.            ((looking-at vip-NONALPHASEP-B)
  158.         (skip-chars-backward vip-NONALPHASEP))
  159.            (t (funcall word-function-back 1)))
  160.      
  161.      (setq word-beg (point))
  162.      
  163.      (setq skip-flag t)
  164.      (while (> count 0)
  165.        ;; skip-flag and the test for 1-char word takes care of the
  166.        ;; special treatment that vip-end-of-word gives to 1-character
  167.        ;; words. Otherwise, clicking once on such a word will insert two
  168.        ;; words.
  169.        (if (and skip-flag (funcall one-char-word-func))
  170.            (setq skip-flag (not skip-flag))
  171.          (funcall word-function-forw 1))
  172.        (setq count (1- count)))
  173.      
  174.      (vip-forward-char-carefully)
  175.      (setq result (buffer-substring word-beg (point))))
  176.        ) ; if
  177.      ;; XEmacs doesn't have set-text-propertiesr, but there buffer-substring
  178.      ;; doesn't return properties together with the string, so it's not needed.
  179.      (if vip-emacs-p
  180.      (set-text-properties 0 (length result) nil result))
  181.      result
  182.      ))
  183.  
  184.  
  185. (defun vip-mouse-click-get-word (click count click-count)
  186.   "Returns word surrounding the position of a mouse click.
  187. Click may be in another window. Current window and buffer isn't changed.
  188. On single or double click, returns the word as determined by
  189. `vip-surrounding-word-function'."
  190.      
  191.   (let ((click-word "")
  192.     (click-pos (vip-mouse-click-posn click))
  193.     (click-buf (vip-mouse-click-window-buffer click)))
  194.     (or (numberp count) (setq count 1))
  195.     (or (numberp click-count) (setq click-count 1))
  196.      
  197.     (save-excursion
  198.       (save-window-excursion
  199.     (if click-pos
  200.         (progn
  201.           (set-buffer click-buf)
  202.     
  203.           (goto-char click-pos)
  204.           (setq click-word
  205.             (funcall vip-surrounding-word-function count click-count)))
  206.       (error "Click must be over a window."))
  207.     click-word))))
  208.  
  209. ;; Returns window where click occurs
  210. (defsubst vip-mouse-click-frame (click)
  211.   (window-frame (vip-mouse-click-window click)))
  212.  
  213. ;; Returns window where click occurs
  214. (defsubst vip-mouse-click-window (click)
  215.   (if vip-xemacs-p
  216.       (event-window click)
  217.     (posn-window (event-start click))))
  218.  
  219. ;; Returns the buffer of the window where click occurs
  220. (defsubst vip-mouse-click-window-buffer (click)
  221.   (window-buffer (vip-mouse-click-window click)))
  222.  
  223. ;; Returns the name of the buffer in the window where click occurs
  224. (defsubst vip-mouse-click-window-buffer-name (click)
  225.   (buffer-name (vip-mouse-click-window-buffer click)))
  226.  
  227. ;; Returns position of a click
  228. (defsubst vip-mouse-click-posn (click)
  229.   (if vip-xemacs-p
  230.       (event-point click)
  231.     (posn-point (event-start click))))
  232.  
  233. (defun vip-mouse-click-insert-word (click arg)
  234.   "Insert word clicked or double-clicked on.
  235. With prefix argument, N, insert that many words.
  236. This command must be bound to a mouse click.
  237. The double-click action of the same mouse button must not be bound
  238. \(or it must be bound to the same function\).
  239. See `vip-surrounding-word' for the definition of a word in this case."
  240.   (interactive "e\nP")
  241.   (if vip-frame-of-focus    ;; to handle clicks in another frame
  242.       (select-frame vip-frame-of-focus))
  243.       
  244.   ;; turn arg into a number
  245.   (cond ((numberp arg) nil)
  246.     ;; prefix arg is a list when one hits C-u then command
  247.     ((and (listp arg) (numberp (car arg)))
  248.      (setq arg (car arg)))
  249.     (t (setq arg 1)))
  250.       
  251.   (let (click-count interrupting-event)
  252.     (if (and
  253.      (vip-multiclick-p)
  254.      ;; This trick checks if there is a pending mouse event
  255.      ;; if so, we use this latter event and discard the current mouse click
  256.      ;; If the next panding event is not a mouse event, we execute
  257.      ;; the current mouse event
  258.      (progn
  259.        (setq interrupting-event (vip-read-event))
  260.        (vip-mouse-event-p last-input-event)))
  261.     (progn ;; interrupted wait
  262.       (setq vip-global-prefix-argument arg)
  263.       ;; count this click for XEmacs
  264.       (vip-event-click-count click))
  265.       ;; uninterrupted wait or the interrupting event wasn't a mouse event
  266.       (setq click-count (vip-event-click-count click))
  267.       (if (> click-count 1)
  268.       (setq arg vip-global-prefix-argument
  269.         vip-global-prefix-argument nil))
  270.       (insert (vip-mouse-click-get-word click arg click-count))
  271.       (if (and interrupting-event
  272.            (eventp interrupting-event)
  273.            (not (vip-mouse-event-p interrupting-event)))
  274.       (vip-set-unread-command-events interrupting-event))
  275.       )))
  276.   
  277. ;; arg is an event. accepts symbols and numbers, too
  278. (defun vip-mouse-event-p (event)
  279.   (if (eventp event)
  280.       (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
  281.             (prin1-to-string (vip-event-key event)))))
  282.   
  283. ;; XEmacs has no double-click events. So, we must simulate.
  284. ;; So, we have to simulate event-click-count.
  285. (defun vip-event-click-count (click)
  286.   (if vip-xemacs-p
  287.       (progn
  288.     ;; if more than 1 second
  289.     (if (> (- (event-timestamp click) vip-last-click-event-timestamp)
  290.            vip-multiclick-timeout)
  291.         (setq vip-current-click-count 0))
  292.     (setq vip-last-click-event-timestamp (event-timestamp click)
  293.           vip-current-click-count (1+ vip-current-click-count)))
  294.     (event-click-count click)))
  295.     
  296.  
  297.  
  298. (defun vip-mouse-click-search-word (click arg)
  299.    "Find the word clicked or double-clicked on. Word may be in another window.
  300. With prefix argument, N, search for N-th occurrence.
  301. This command must be bound to a mouse click. The double-click action of the
  302. same button must not be bound \(or it must be bound to the same function\).
  303. See `vip-surrounding-word' for the details on what constitutes a word for
  304. this command."
  305.   (interactive "e\nP")
  306.   (if vip-frame-of-focus    ;; to handle clicks in another frame
  307.       (select-frame vip-frame-of-focus))
  308.   (let (click-word click-count
  309.     (previous-search-string vip-s-string))
  310.     
  311.     (if (and
  312.      (vip-multiclick-p)
  313.      ;; This trick checks if there is a pending mouse event
  314.      ;; if so, we use this latter event and discard the current mouse click
  315.      ;; If the next pending event is not a mouse event, we execute
  316.      ;; the current mouse event
  317.      (progn
  318.        (vip-read-event)
  319.        (vip-mouse-event-p last-input-event)))
  320.     (progn ;; interrupted wait
  321.       (setq vip-global-prefix-argument 
  322.         (or vip-global-prefix-argument arg))
  323.       ;; remember command that was before the multiclick
  324.       (setq this-command last-command)
  325.       ;; make sure we counted this event---needed for XEmacs only
  326.       (vip-event-click-count click))
  327.       ;; uninterrupted wait
  328.       (setq click-count (vip-event-click-count click))
  329.       (setq click-word (vip-mouse-click-get-word click nil click-count))
  330.     
  331.       (if (> click-count 1)
  332.       (setq arg vip-global-prefix-argument
  333.         vip-global-prefix-argument nil))
  334.       (setq arg (or arg 1))
  335.     
  336.       (vip-deactivate-mark)
  337.       (if (or (not (string= click-word vip-s-string))
  338.           (not (markerp vip-search-start-marker))
  339.           (not (equal (marker-buffer vip-search-start-marker)
  340.               (current-buffer)))
  341.           (not (eq last-command 'vip-mouse-click-search-word)))
  342.       (progn
  343.         (setq  vip-search-start-marker (point-marker)
  344.            vip-local-search-start-marker vip-search-start-marker
  345.            vip-mouse-click-search-noerror t
  346.            vip-mouse-click-search-limit nil)
  347.         
  348.         ;; make search string known to Viper
  349.         (setq vip-s-string (if vip-re-search
  350.                    (regexp-quote click-word)
  351.                  click-word))
  352.         (if (not (string= vip-s-string (car vip-search-history)))
  353.         (setq vip-search-history
  354.               (cons vip-s-string vip-search-history)))
  355.         ))
  356.       
  357.       (push-mark nil t)
  358.       (while (> arg 0)
  359.     (vip-forward-word 1)
  360.     (condition-case nil
  361.         (progn
  362.           (if (not (search-forward click-word vip-mouse-click-search-limit
  363.                        vip-mouse-click-search-noerror))
  364.           (progn
  365.             (setq vip-mouse-click-search-noerror nil)
  366.             (setq vip-mouse-click-search-limit
  367.               (save-excursion
  368.                 (if (and
  369.                  (markerp vip-local-search-start-marker)
  370.                  (marker-buffer vip-local-search-start-marker))
  371.                 (goto-char vip-local-search-start-marker))
  372.                 (vip-line-pos 'end)))
  373.                 
  374.             (goto-char (point-min))
  375.             (search-forward click-word
  376.                     vip-mouse-click-search-limit nil)))
  377.           (goto-char (match-beginning 0))
  378.           (message "Searching for: %s" vip-s-string)
  379.           (if (<= arg 1)
  380.           (vip-flash-search-pattern))
  381.           )
  382.       (error (beep 1)
  383.          (if (or (not (string= click-word previous-search-string))
  384.              (not (eq  last-command 'vip-mouse-click-search-word)))
  385.              (message "`%s': String not found in %s"
  386.                   vip-s-string (buffer-name (current-buffer)))
  387.            (message
  388.             "`%s': Last occurrence in %s. Back to beginning of search"
  389.             click-word (buffer-name (current-buffer)))
  390.            (setq arg 1) ;; to terminate the loop
  391.            (sit-for 2))
  392.          (setq  vip-mouse-click-search-noerror t) 
  393.          (setq  vip-mouse-click-search-limit nil)
  394.          (if (and (markerp vip-local-search-start-marker)
  395.               (marker-buffer vip-local-search-start-marker))
  396.              (goto-char vip-local-search-start-marker))))
  397.     (setq arg (1- arg)))
  398.       )))
  399.   
  400. (defun vip-mouse-catch-frame-switch (event arg)
  401.   "Catch the event of switching frame.
  402. Usually is bound to a 'down-mouse' event to work properly. See sample
  403. bindings in viper.el and in the Viper manual."
  404.   (interactive "e\nP")
  405.   (setq vip-frame-of-focus nil)
  406.   ;; pass prefix arg along to vip-mouse-click-search/insert-word
  407.   (setq prefix-arg arg)
  408.   (if (eq last-command 'handle-switch-frame)
  409.       (setq vip-frame-of-focus vip-current-frame-saved))
  410.   ;; make Emacs forget that it executed vip-mouse-catch-frame-switch
  411.   (setq this-command last-command))
  412.       
  413. ;; Called just before switching frames. Saves the old selected frame.
  414. ;; Sets last-command to handle-switch-frame (this is done automatically in
  415. ;; Emacs. 
  416. ;; The semantics of switching frames is different in Emacs and XEmacs.
  417. ;; In Emacs, if you select-frame A while mouse is over frame B and then
  418. ;; start typing, input goes to frame B, which becomes selected.
  419. ;; In XEmacs, input will go to frame A. This may be a bug in one of the
  420. ;; Emacsen, but also may be a design decision.
  421. ;; Also, in Emacs sending input to frame B generates handle-switch-frame
  422. ;; event, while in XEmacs it doesn't.
  423. ;; All this accounts for the difference in the behavior of
  424. ;; vip-mouse-click-* commands when you click in a frame other than the one
  425. ;; that was the last to receive input. In Emacs, focus will be in frame A
  426. ;; until you do something other than vip-mouse-click-* command.
  427. ;; In XEmacs, you have to manually select frame B (with the mouse click) in
  428. ;; order to shift focus to frame B.
  429. (defsubst vip-remember-current-frame (frame)
  430.   (setq last-command 'handle-switch-frame
  431.     vip-current-frame-saved (selected-frame)))
  432.  
  433.  
  434. (cond ((vip-window-display-p)
  435.        (let* ((search-key (if vip-xemacs-p [(meta button1up)] [S-mouse-1]))
  436.           (search-key-catch (if vip-xemacs-p
  437.                     [(meta button1)] [S-down-mouse-1]))
  438.           (insert-key (if vip-xemacs-p [(meta button2up)] [S-mouse-2]))
  439.           (insert-key-catch (if vip-xemacs-p
  440.                     [(meta button2)] [S-down-mouse-2]))
  441.           (search-key-unbound (and (not (key-binding search-key))
  442.                        (not (key-binding search-key-catch))))
  443.           (insert-key-unbound (and (not (key-binding insert-key))
  444.                        (not (key-binding insert-key-catch))))
  445.           )
  446.          
  447.      (if search-key-unbound
  448.          (global-set-key search-key 'vip-mouse-click-search-word))
  449.      (if insert-key-unbound
  450.          (global-set-key insert-key 'vip-mouse-click-insert-word))
  451.     
  452.      ;; The following would be needed if you want to use the above two
  453.      ;; while clicking in another frame. If you only want to use them
  454.      ;; by clicking in another window, not frame, the bindings below
  455.      ;; aren't necessary.
  456.      
  457.      ;; These must be bound to mouse-down event for the same mouse
  458.      ;; buttons as 'vip-mouse-click-search-word and
  459.      ;; 'vip-mouse-click-insert-word
  460.      (if search-key-unbound
  461.          (global-set-key search-key-catch   'vip-mouse-catch-frame-switch))
  462.      (if insert-key-unbound
  463.          (global-set-key insert-key-catch   'vip-mouse-catch-frame-switch))
  464.      
  465.      (if vip-xemacs-p
  466.          (add-hook 'mouse-leave-frame-hook
  467.                'vip-remember-current-frame)
  468.        (defadvice handle-switch-frame (before vip-frame-advice activate)
  469.          "Remember the selected frame before the switch-frame event." 
  470.          (vip-remember-current-frame (selected-frame))))
  471.        )))
  472.  
  473.  
  474.  
  475. (provide 'viper-mous)
  476.  
  477. ;;;  viper-mous.el ends here
  478.